home *** CD-ROM | disk | FTP | other *** search
/ HTBasic 9.3 / HTBasic 9.3.iso / 61win / data1.cab / Lexical_Order_files / HP2PC.BAS next >
BASIC Source File  |  2001-03-02  |  7KB  |  179 lines
  1. 10!RE-SAVE "HP2PC.BAS"
  2. 20    ! - Translate an ASCII file from HP character set to 850 or Latin-1.
  3. 30    ! This program is documented in the User's Guide. Check the index to locate the page.
  4. 40    COM /Hp2pc/Pc2hp$[256],Hp2pc$[256]
  5. 50    DIM L$[258],L1$[80]
  6. 60    INTEGER I,Cs
  7. 70    !
  8. 80    PRINT "HP2PC - Version 26-Aug-93"
  9. 90    PRINT "Translate from Roman-8 (HP BASIC) to PC-850 or Latin-1."
  10. 100   PRINT
  11. 110   LOOP
  12. 120     INPUT "Enter 1 for PC-850, Enter 2 for Latin-1",Cs
  13. 130   EXIT IF Cs=1 OR Cs=2
  14. 140     DISP "ERROR, try again: ";
  15. 150   END LOOP
  16. 160   Make_pc2hp(Cs) ! Set up translation strings
  17. 170   Make_hp2pc(Cs)
  18. 180   INPUT "Translate what file?",L$
  19. 190   ASSIGN @I TO L$;FORMAT ON
  20. 200   LOOP
  21. 210     INPUT "What should the translated file be called?",L1$
  22. 220   EXIT IF L$<>L1$
  23. 230     PRINT "The translated file must have a new name."
  24. 240   END LOOP
  25. 250   ON ERROR GOTO 270
  26. 260   CREATE ASCII L1$,1
  27. 270   OFF ERROR
  28. 280   IF ERRN=54 THEN
  29. 290     PRINT "The file ";L1$;" already exists."
  30. 300     PRINT "Choose another filename."
  31. 310     GOTO 180
  32. 320   END IF
  33. 330   ASSIGN @O TO L1$;FORMAT ON
  34. 340   !
  35. 350   ON END @I GOTO Done
  36. 360   LOOP
  37. 370     ENTER @I;L$
  38. 380     OUTPUT @O;FNHp2pc$(L$)
  39. 390   END LOOP
  40. 400 Done: ASSIGN @I TO *
  41. 410   ASSIGN @O TO *
  42. 420   PRINT
  43. 430   PRINT "Translation complete."
  44. 440   PRINT "Remember to add the CONTROL KBD,100;1 statement if necessary to your programs."
  45. 450   END
  46. 460   !
  47. 470   !
  48. 480   !
  49. 490   SUB Make_pc2hp(INTEGER Cs)
  50. 500     !Set up translation string from Cs to Roman-8. Cs=1: PC-850, Cs=2: Latin-1
  51. 510     !Any attributes moved down to 16-31 aren't handled.
  52. 520     IF Cs=2 THEN RESTORE Latin1
  53. 530     FOR I=0 TO 127
  54. 540       Pc2hp$[I+1;1]=CHR$(I)
  55. 550     NEXT I
  56. 560     !
  57. 570     FOR I=128 TO 255
  58. 580       READ C
  59. 590       Pc2hp$[I+1;1]=CHR$(C)
  60. 600     NEXT I
  61. 610     SUBEXIT
  62. 620     !
  63. 630     COM /Hp2pc/Pc2hp$[256],Hp2pc$[256]
  64. 640     INTEGER I,C
  65. 650     !
  66. 660 Pc850:!
  67. 670     !PC code page 850 to Roman-8 translation string.
  68. 680     !If no translation exists for a PC character, CHR$(252) is returned.
  69. 690     DATA 180,207,197,192,204,200,212,181,193,205,201,221,209,217,216,208
  70. 700     DATA 220,215,211,194,206,202,195,203,239,218,219,214,187,210,252,190
  71. 710     DATA 196,213,198,199,183,182,249,250,185,252,252,248,247,184,251,253
  72. 720     DATA 252,252,252,252,252,224,162,161,252,252,252,252,252,191,188,252
  73. 730     DATA 252,252,252,252,252,252,226,225,252,252,252,252,252,252,252,186
  74. 740     DATA 228,227,164,165,163,252,229,166,167,252,252,252,252,252,230,252
  75. 750     DATA 231,222,223,232,234,233,243,241,240,237,174,173,178,177,176,168
  76. 760     DATA 246,254,252,245,244,189,252,252,179,171,242,252,252,252,252,255
  77. 770     !
  78. 780 Latin1:!
  79. 790     !Latin-1 to Roman-8 translation string.
  80. 800     !If no translation exists for a PC character, CHR$(252) is returned.
  81. 810     DATA 128,129,130,131,132,133,134,135,136,137,138,139,140,141,142,143
  82. 820     DATA 144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159
  83. 830     DATA 160,184,191,187,186,188,124,189,171,252,249,251,252,246,252,176
  84. 840     DATA 179,254,252,252,168,243,244,242,252,252,250,253,247,248,245,185
  85. 850     DATA 161,224,162,225,216,208,211,180,163,220,164,165,230,229,166,167
  86. 860     DATA 227,182,232,231,223,233,218,252,210,173,237,174,219,177,240,222
  87. 870     DATA 200,196,192,226,204,212,215,181,201,197,193,205,217,213,209,221
  88. 880     DATA 228,183,202,198,194,234,206,252,214,203,199,195,207,178,241,239
  89. 890   SUBEND
  90. 900   !
  91. 910   !
  92. 920   !
  93. 930   SUB Make_hp2pc(INTEGER Cs)
  94. 940     !Set up translation string from Roman-8 to Cs. Cs=1: PC-850, Cs=2: Latin-1
  95. 950     IF Cs=2 THEN RESTORE Latin1
  96. 960     FOR I=0 TO 127
  97. 970       Hp2pc$[I+1;1]=CHR$(I)
  98. 980     NEXT I
  99. 990     !
  100. 1000    FOR I=128 TO 255
  101. 1010      READ C
  102. 1020      Hp2pc$[I+1;1]=CHR$(C)
  103. 1030    NEXT I
  104. 1040    SUBEXIT
  105. 1050    !
  106. 1060    COM /Hp2pc/Pc2hp$[256],Hp2pc$[256]
  107. 1070    INTEGER I,C
  108. 1080    !
  109. 1090 Pc850:!
  110. 1100    !Roman-8 to PC code page 850 translation string.
  111. 1110    !If no translation exists for an HP character, CHR$(219) is returned
  112. 1120    DATA  16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31
  113. 1130    DATA 219,219,219,219,219,219,219,219,219,219,219,219,219,219,219,219
  114. 1140    DATA 219,183,182,212,210,211,215,216,239, 96, 94,249,126,235,234,156
  115. 1150    DATA 238,237,236,248,128,135,165,164,173,168,207,156,190,245,159,189
  116. 1160    DATA 131,136,147,150,160,130,162,163,133,138,149,151,132,137,148,129
  117. 1170    DATA 143,140,157,146,134,161,155,145,142,141,153,154,144,139,225,226
  118. 1180    DATA 181,199,198,209,208,214,222,224,227,229,228, 83,115,233, 89,152
  119. 1190    DATA 232,231,250,230,244,243,240,172,171,166,167,174,254,175,241,255
  120. 1200    !
  121. 1210 Latin1:!
  122. 1220    !Roman-8 to Latin-1 translation string.
  123. 1230    !If no translation exists for an HP character, CHR$(42) is returned
  124. 1240    DATA  16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31
  125. 1250    DATA 144,145,146,147,148,149,150,151,152,153,154,155,156,157,158,159
  126. 1260    DATA 160,192,194,200,202,203,206,207,180, 96, 94,168,126,217,219,163
  127. 1270    DATA 175,221,253,176,199,231,209,241,161,191,164,163,165,167, 42,162
  128. 1280    DATA 226,234,244,251,225,233,243,250,224,232,242,249,228,235,246,252
  129. 1290    DATA 197,238,216,198,229,237,248,230,196,236,214,220,201,239,223,212
  130. 1300    DATA 193,195,227,208,240,205,204,211,210,213,245, 83,115,218, 89,255
  131. 1310    DATA 222,254,183,181,182,190,173,188,189,170,186,171, 42,187,177,255
  132. 1320  SUBEND
  133. 1330  !
  134. 1340  !
  135. 1350  !
  136. 1360  DEF FNHp2pc$(S$)
  137. 1370    COM /Hp2pc/Pc2hp$[256],Hp2pc$[256]
  138. 1380    RETURN FNXlat$(S$,Hp2pc$)
  139. 1390  FNEND
  140. 1400  !
  141. 1410  !
  142. 1420  !
  143. 1430  DEF FNPc2hp$(S$)
  144. 1440    COM /Hp2pc/Pc2hp$[256],Hp2pc$[256]
  145. 1450    RETURN FNXlat$(S$,Pc2hp$)
  146. 1460  FNEND
  147. 1470  !
  148. 1480  !
  149. 1490  !
  150. 1500  DEF FNXlat$(O$,X$)
  151. 1510    INTEGER I,L,J
  152. 1520    L=LEN(O$)
  153. 1530    ALLOCATE N$[L]
  154. 1540    !
  155. 1550    ! Translate literal characters
  156. 1560    !
  157. 1570    FOR I=1 TO L
  158. 1580      N$[I;1]=X$[NUM(O$[I;1])+1;1]
  159. 1590    NEXT I
  160. 1600    !
  161. 1610    ! Translate CHR$ characters
  162. 1620    !
  163. 1630    I=POS(N$,"CHR$(")
  164. 1640    WHILE I
  165. 1650      IF L>=I+8 AND N$[I+8;1]=")" THEN
  166. 1660        IF VAL(N$[I+5;3])>127 THEN
  167. 1670          N$[I+5;3]=VAL$(NUM(X$[VAL(N$[I+5;3])+1;1]))
  168. 1680        END IF
  169. 1690      END IF
  170. 1700      J=POS(N$[I+1],"CHR$(")
  171. 1710      IF J THEN
  172. 1720        I=I+J
  173. 1730      ELSE
  174. 1740        I=0
  175. 1750      END IF
  176. 1760    END WHILE
  177. 1770    RETURN N$
  178. 1780  FNEND
  179.